;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10 -*-
;;; Name: Chih Chin Chang, John Sult, Quoc                              Date: 10/25/2013
;;; Course: ICS313        Assignment:   5
;;; File: header.lisp
(defconstant +ID+ "Chih Chin Chang, John Sult, Quoc Hnyuh")
(defun id (class assn)
;; prints the name, course, and assignment number
  (cond
   ((not (numberp class))
    (princ "class must be a number")
    () )
   ((not (numberp assn))
    (princ "assignment number must be a number")
    () )
   (t
    (princ "Name: ")
    (princ +ID+)
    (terpri)
    (princ "Course: ")
    (princ class)
    (terpri)
    (princ "Assignment # ")
    (princ assn)
    () )))

(in-package :User) ; optional 
; wizards_game

;; Holds a list of locations and its description
(defparameter *nodes* '((glen (You are standing in the middle of a picturesque glen. A river torrents behind you as the noise of water splitting rocks deafens your senses.))
                        (mudpath (The mud blackens your shoes as you trudge through the windy muddy path. A snake bites your leg. You are now poisoned.))
                        (traintracks (Mossy green paints over rust as the tracks snake towards the mountain.))
			(foothill (Piles of crumpled papers litter the bottom of the mountain. Mostly illegible. Jasmine petals carpets the ground. You step into them like fresh snow in early winter.))
                        
                        (tree (A giant tree stands before you scarred and gray. Branches hangs like broken limbs-- dead and brittle. Sap runs down its trunk gluing helpless critters to its wounds.))
                        (field (Shades of orange and red surrounds you as you run your fingers over the sea of wheat stalks. A tree stands defiantly to your right amidst the field. A box is rooted to the ground.))
                        (doors (You are standing in front of some doors. There is a keyhole.))))

;; defines the connections between locations
(defparameter *edges* '(
                        (doors (foothill right path))
                        (glen (mudpath right path))
                        (mudpath (traintracks north path) (glen left path))
                        (traintracks (field right path) (foothill north tracks) (mudpath south path))
                        (tree (field left path))
                        (field (tree right path) (traintracks left path))
			(foothill (traintracks south tracks) (doors left path))
                        ))

;; describes all the objects in the world
(defparameter *objects* '(paper mug rock mud pen petals recipe box branch axehead sap))

;; describes the item and its location
(defparameter *object-locations* '((paper glen)
                                   (branch tree)
                                   (axehead tree)
                                   (sap tree)
                                   (mug glen)
				   (rock mudpath)
				   (mud mudpath)
				   (pen traintracks)
				   (petals foothill)
                                   (recipe throne)
                                   (frog garden)))

;; current location
(defparameter *location* 'glen)

;; end game
(defparameter *gameend* nil)

;; the main game loop
(defun game-repl ()
    (let ((cmd (game-read)))
        (unless *gameend*
            (if (not (eq (car cmd) 'quit))
                (progn (game-print (game-eval cmd))
                  (game-repl))
              (setf *gameend* 't)))))

;; reads a string, add lisp syntax like paranthesis and single quote
(defun game-read ()
    (let ((cmd (read-from-string (concatenate 'string "(" (read-line) ")"))))
         (flet ((quote-it (x)
                    (list 'quote x)))
             (cons (car cmd) (mapcar #'quote-it (cdr cmd))))))

;; list of allowed commands
(defparameter *allowed-commands* '(look walk pickup inventory help?))

;; get in-game help
(defun help? ()
       (cond
        ((equal *location* 'glen)
         (princ "Available commands: pickup, inventory, look, walk, guess recipe, make axehead branch sap, pread paper, rread recipe") (terpri))
        ((equal *location* 'throne)
         (princ "Available commands: pickup, inventory, look, walk, make, guess recipe, make axehead branch sap, pread paper, rread recipe, makeoffer mug") (terpri))
        ((equal *location* 'field)
         (princ "Available commands: pickup, inventory, look, walk, make, guess recipe, gopen axe box, make axehead branch sap, pread paper, rread recipe") (terpri))
        ((equal *location* 'tree)
         (princ "Available commands: pickup, inventory, look, walk, make, guess recipe, make axehead branch sap, pread paper, rread recipe") (terpri))
        ((equal *location* 'mudpath)
         (princ "Available commands: pickup, inventory, look, walk, guess recipe, fillmud mug mud, make axehead branch sap, pread paper, rread recipe") (terpri))
        ((equal *location* 'traintracks)
         (princ "Available commands: pickup, inventory, look, walk, guess recipe, make axehead branch sap, pread paper, rread recipe") (terpri))
        ((equal *location* 'foothill)
         (princ "Available commands: pickup, inventory, look, walk, guess recipe, fillpetals mug petals, make axehead branch sap, pread paper, rread recipe") (terpri))
        ((equal *location* 'doors)
         (princ "Available commands: use key keyhole, walk, look, inventory, guess recipe, make axehead branch sap, pread paper, rread recipe") (terpri))))
       

;; if entered expression is allowed, evaluate the command
(defun game-eval (sexp)
  (cond
   ((and
     (not (equal (car sexp) 'help))
     (not (equal (car sexp) 'h))
     (not (equal (car sexp) '?))
         (if (member (car sexp) *allowed-commands*)
             (eval sexp)
           '(i do not know that command.))))))

;; helper function for game-print
(defun tweak-text (lst caps lit)
  (when lst
    (let ((item (car lst))
          (rest (cdr lst)))
      (cond ((eql item #\space) (cons item (tweak-text rest caps lit)))
            ((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit)))
            ((eql item #\") (tweak-text rest caps (not lit)))
            (lit (cons item (tweak-text rest nil lit)))
            (caps (cons (char-upcase item) (tweak-text rest nil lit)))
            (t (cons (char-downcase item) (tweak-text rest nil nil)))))))
;;prints the game
(defun game-print (lst)
    (princ (coerce (tweak-text (coerce (string-trim "() " (prin1-to-string lst)) 'list) t nil) 'string))
    (fresh-line))

;; finds the location within the nodes and returns its description
(defun describe-location (location nodes)
   (cadr (assoc location nodes)))


;; describes the path given the edge
(defun describe-path (edge)
  `(there is a ,(caddr edge) going ,(cadr edge) from here.))

;; describe all the paths from the location
(defun describe-paths (location edges)
  (apply #'append (mapcar #'describe-path (cdr (assoc location edges)))))



;; finds objects in a location
(defun objects-at (loc objs obj-loc)
   (labels ((is-at (obj)
              (eq (cadr (assoc obj obj-loc)) loc)))
       (remove-if-not #'is-at objs)))

;; describes the object
(defun describe-objects (loc objs obj-loc)
   (labels ((describe-obj (obj)
                `(you see a ,obj on the floor.)))
      (apply #'append (mapcar #'describe-obj (objects-at loc objs obj-loc)))))

;; look at current location 
(defun look ()
  (append (describe-location *location* *nodes*)
          (describe-paths *location* *edges*)
          (describe-objects *location* *objects* *object-locations*)))

;; move in a direction
(defun walk (direction)
  (labels ((correct-way (edge)
             (eq (cadr edge) direction)))
    (let ((next (find-if #'correct-way (cdr (assoc *location* *edges*)))))
      (if next 
          (progn (setf *location* (car next)) 
                 (look))
          '(you cannot go that way.)))))
;; pickup object
(defun pickup (object)
  (cond ((member object (objects-at *location* *objects* *object-locations*))
         (push (list object 'body) *object-locations*)
         `(you are now carrying the ,object))
	  (t '(you cannot get that.))))

;; view inventory
(defun inventory ()
  (cons 'items- (objects-at 'body *objects* *object-locations*)))

;; view objects holding
(defun have (object) 
    (member object (cdr (inventory))))

;; template for game action at specific location
(defmacro game-action (command subj obj place &body body)
  `(progn (defun ,command (subject object)
            (if (and (eq *location* ',place)
                     (eq subject ',subj)
                     (eq object ',obj)
                     )
                ,@body
              '(i cant ,command like that.)))
     (pushnew ',command *allowed-commands*)))

;; template for single object commands
(defmacro gen-game-action (command obj &body body)
  `(progn (defun ,command (object)
            (if  (and (eq object ',obj) (have ',obj))
                ,@body
              '(i cant ,command like that.)))
     (pushnew ',command *allowed-commands*)))

;;template for triple objects commands
(defmacro tgame-action (command ob1 ob2 ob3 &body body)
  `(progn (defun ,command (obj1 obj2 obj3)
            (if (and (eq obj1 ',ob1) (eq obj2 ',ob2) (eq obj3 ',ob3) (have ',ob1) (have ',ob2) (have ',ob3))
                ,@body
              '(i can't ,command like that.)))
     (pushnew ',command *allowed-commands*)))

;; checks if you have completed each task
(defparameter *axe* nil)
(defparameter *key* nil)
(defparameter *mug* nil)
(defparameter *cure* nil)
(defparameter *recipe* nil)
(defparameter *door* nil)

;; fills mug with mud
(game-action fillmud mug mud mudpath
  (if (and (have 'mug) (eq *location* 'mudpath))
      (progn (setf *mug* 't)
        '(you have filled the mug with mud.))
    '(you have failed to fill the mug)))

;;fills mug with petals
(game-action fillpedal mug petals foothill
  (if (and (eq t *mug*) (have 'petals))
      (progn (setf *cure* 't)
        '(you have filled the mug with petals))
    '(you have failed to fill the mug)))

;; offer mug to throne
(gen-game-action makeoffer mug
  (cond
   ((and *cure* (eq *location* 'throne))
    (princ "you're cured! the end") (terpri)
    (setf *gameend* 't))
   (t
    (princ "you have made the wrong offering to the spirit king. you are dead. the end") (terpri)
    (setf *gameend* 't))))

;; how many guesses made
(defparameter guess-count 0)

;; guess riddle algorithm, you lose if guess too much
(gen-game-action guess recipe
                (progn
                  (cond
                   ((have 'pen)
                    (cond
                     ((> guess-count 3)
                      (princ "the recipe burns into crisps. the end")
                      (setf *gameend* 't))
                     (t
                      (cond
                       ((and (not *recipe*) (have 'recipe))
                        (setq resp (read))
                        (cond
                         ((eq resp 'mountain)
                          (setf *recipe* 't)
                          '(ink spills through the recipe as words begin to form))
                         (t
                          (setf guess-count (+ 1 guess-count))
                          (princ "guess again") (terpri))))
                       (t
                        (princ "no recipe for you") (terpri)))
                      )))
                   (t
                    (princ "you need a pen") (terpri)))))



;; reads paper
(gen-game-action pread paper 
                 (if (have 'paper)
                     (progn 
                       '(Im dying now. Couldnt solve the riddle. The mountain is beautiful this time of year.))
                   '(you do not have a paper.)))
;; reads recipe
(gen-game-action rread recipe
                 (if (and (eq t *recipe*) (have 'recipe))
                     '(1 part Jasmine petals and 1 part mud and last part mug)
                   '(a riddle -- What has roots as nobody sees.
                       Is taller than trees.
                       Up up it goes.
                       And yet never grows?)))
;; make an axe
(tgame-action make axehead branch sap
             (if (and (have 'axehead) (have 'branch) (have 'sap))
                 (progn (setf *axe* 't)
                   '(you have made an axe.))
               '(you have failed to make an axe)))
;; open box with axe
(game-action gopen axe box field
             (if (eq t *axe*)
                 (progn (setf *key* 't)
                   '(You take a key from inside the box.))
               '(You have failed to open the boxsdf)))
;; open door to throne
(game-action use key keyhole doors
             (if (and (eq t *key*) (not *door*))
                 (progn (setf *door* 't)
                   (pushnew '(throne north steps) (cdar *edges*))
                   (pushnew '(throne (An inscription on the throne reads-- the right drink will cure all.)) *nodes*)
                   (pushnew '(throne (doors back steps)) *edges*)
                   '(the doors fell open with an echoed crash))
               '(you have failed to use the key)))

